\ opg.1 of 3 97.11.04 Wil Baden
\ Included by opg.

( Formula Translation using Operator Precedence Grammar )
public:
VARIABLE DEBUG  0 DEBUG !

( Tool Belt. )
public:
: BOUNDS ( a n -- a+n a )  OVER + SWAP ;
: PLACE ( a1 n1 a2 -- ) 2DUP 2>R  CHAR+ SWAP MOVE  2R> C! ;
: STRING ( char "ccc<char>" -- )
  WORD COUNT HERE OVER 1+ CHARS ALLOT PLACE
;

: split-at-char
( a n char -- a+k n-k a k )
  >R  2DUP ( a n a+k n-k)( R: char)
  BEGIN  DUP WHILE  OVER C@ R@ =
  0= WHILE  1 /STRING  REPEAT THEN
  R> DROP ( R: )
  DUP >R  2SWAP  R> - ( a+k n-k a k)
;

( MACRO is Simple Macro from Forth Dimensions. )
: MACRO ( "name <char> ccc<char>" -- )
  :  CHAR PARSE POSTPONE SLITERAL  POSTPONE EVALUATE
  POSTPONE ; IMMEDIATE
;

MACRO FAILURE " FALSE EXIT "
MACRO SUCCESS " TRUE EXIT "
MACRO ANDIF  " DUP IF DROP "
MACRO ORIF  " ?DUP 0= IF "

( ?? conditionally executes the following word. )
: ?? ( "word" -- ??? )
  S" IF " EVALUATE
  BL WORD COUNT EVALUATE
  S" THEN " EVALUATE
; IMMEDIATE

( `GET-CHAR`  Get character from input stream. )
: GET-CHAR ( -- char or 0 for EOL or negative for EOF )
  SOURCE  >IN @  > IF  >IN @ CHARS + C@  1 >IN +!
  ELSE  DROP REFILL 0=
  THEN
;

( This definition is one way to define `ANEW`. )
\ : ANEW  >IN @ BL WORD FIND IF EXECUTE ELSE DROP THEN >IN ! MARKER ;

: OFF ( addr -- ) FALSE SWAP ! ;
: ON ( addr -- ) TRUE SWAP ! ;

MACRO NOT " 0= "

( Character Handling )

( `replace-last-char`  Replace the last character in a string. )
: replace-last-char ( str len char -- str len )
  >R  2DUP CHARS +  R> SWAP C!
;

: isdigit ( char -- flag ) [CHAR] 0 -  10 U< ;
: isalpha ( char -- flag ) BL OR  [CHAR] a -  26 U< ;
: isalnum ( char -- flag ) DUP isalpha  ORIF DUP isdigit THEN  NIP ;

: is+or- ( char -- flag ) DUP [CHAR] + =  ORIF DUP [CHAR] - = THEN  NIP ;
: isDorE ( char -- flag ) BL OR  [CHAR] d -  2 U< ;

private:
( This awful-looking code walks through the syntax for a number. )
\  [+-]?[0-9]*([.][0-9]*)?
\     ([dDeE](([-+][0-9])?[0-9]*)?
: is-number ( str len -- str' len' flag )
  DUP 0= ?? FAILURE

  \ [-+]  Any sign.
  OVER C@ is+or- IF
  1 /STRING
  DUP 0= ?? FAILURE
  THEN

  \ [.]?[0-9]  Begins with digit or
  \ decimal point and digit.
  OVER C@ isdigit  ORIF  OVER C@ [CHAR] . =  THEN 0= ?? FAILURE
  OVER C@ [CHAR] . = IF
  DUP 1 = ?? FAILURE
  OVER CHAR+ C@ isdigit 0= ?? FAILURE
  THEN

  \ [0-9]*  Any digits.
  BEGIN  OVER C@ isdigit
  WHILE  1 /STRING  DUP 0= ?? SUCCESS
  REPEAT

  \ [.][0-9]*  Decimal point and any
  \ digits
  OVER C@ [CHAR] . = IF
  1 /STRING
  BEGIN  DUP 0= ?? SUCCESS
  OVER C@ isdigit
  WHILE  1 /STRING  REPEAT
  THEN

  \ [dDeE](([-+][0-9])?[0-9]*)?
  \ Exponent and any sign and digits.
  OVER C@ isDorE IF
  1 /STRING
  DUP 0= ?? SUCCESS
  OVER C@ is+or- IF
  1 /STRING
  DUP 0= ?? FAILURE
  OVER C@ isdigit 0= ?? FAILURE
  THEN
  \ [0-9]*
  BEGIN  DUP 0= ?? SUCCESS
  OVER C@ isdigit
  WHILE  1 /STRING  REPEAT
  THEN

  SUCCESS
;
